home *** CD-ROM | disk | FTP | other *** search
/ Aminet 21 / Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso / Aminet / dev / misc / p96pcq.lha / Picasso96PCQ / Examples / OpenScreen.p < prev    next >
Encoding:
Text File  |  1997-07-18  |  7.3 KB  |  271 lines
  1.  
  2. PROGRAM OpenScreen;
  3.  
  4. {
  5.     PCQ-Version des Picasso96-Demoprogrammes
  6.  
  7.     in Pascal übersetzt von Andreas Neumann
  8. }
  9.  
  10. {$I "Include:exec/memory.i" }
  11. {$I "Include:exec/interrupts.i" }
  12. {$I "Include:exec/libraries.i" }
  13. {$I "Include:dos/RDArgs.i" }
  14. {$I "Include:libraries/dos.i" }
  15. {$I "Include:graphics/graphics.i" }
  16. {$I "Include:graphics/pens.i" }
  17. {$I "Include:intuition/intuition.i" }
  18. {$I "Include:utils/random.i" }
  19. {$I "Include:p96/Picasso96.i" }
  20.  
  21. Const
  22.     gfxname     :   String  =   "graphics.library";
  23.     ScreenTitle :   String  =   "Picasso96 API Test";
  24.     W1Title     :   String  =   "WritePixel";
  25.     W2Title     :   String  =   "FillRect";
  26.     Pens        :   Array [0..0] Of Short = (NOT(0));
  27.     template    :   String  =   "Width=W/N,Height=H/N,Depth=D/N";
  28.     vecarray    :   Array[0..2] of Address = (Nil, Nil, Nil);
  29.  
  30.  
  31. Var
  32.     i       :   Integer;
  33.     sc      :   ScreenPtr;
  34.     windowtags,
  35.     ptags   :   Array [0..32] Of TagItem;
  36.     wdf,
  37.     wdp     :   WindowPtr;
  38.     rpf,
  39.     rpp     :   RastPortPtr;
  40.     terminate   :   Boolean;
  41.     signals     :   Integer;
  42.     format      :   RGBFTYPE;
  43.     x1, y1,
  44.     x2, y2,
  45.     x3, y3      :   Short;
  46.     imsg        :   IntuiMessagePtr;
  47.     msg         :   MessagePtr;
  48.     Dimensions  :   Array [0..3] Of Short;
  49.     Width,
  50.     Height,
  51.     Depth       :   Integer;
  52.     rda         :   RDArgsPtr;
  53.  
  54. BEGIN
  55.  Width:=640;
  56.  Height:=480;
  57.  Depth:=8;
  58.  
  59.  rda:=ReadArgs (template,Adr(vecarray),Nil);
  60.  If rda<>Nil Then
  61.  Begin
  62.   If vecarray[0]<>NIL then CopyMem(vecarray[0],adr(width),4);
  63.   If vecarray[1]<>NIL then CopyMem(vecarray[1],adr(height),4);
  64.   If vecarray[2]<>NIL then CopyMem(vecarray[2],adr(depth),4);
  65.   FreeArgs(rda);
  66.  End;
  67.  
  68.  windowtags[0].ti_Tag:=WA_Width;
  69.  windowtags[0].ti_Data:=200;
  70.  windowtags[1].ti_Tag:=WA_Height;
  71.  windowtags[1].ti_Data:=300;
  72.  windowtags[2].ti_Tag:=WA_MinWidth;
  73.  windowtags[2].ti_Data:=100;
  74.  windowtags[3].ti_Tag:=WA_MinHeight;
  75.  windowtags[3].ti_Data:=100;
  76.  windowtags[4].ti_Tag:=WA_MaxWidth;
  77.  windowtags[4].ti_Data:=-1;
  78.  windowtags[5].ti_Tag:=WA_MaxHeight;
  79.  windowtags[5].ti_Data:=-1;
  80.  windowtags[6].ti_Tag:=WA_SimpleRefresh;
  81.  windowtags[6].ti_Data:=Integer(TRUE);
  82.  windowtags[7].ti_Tag:=WA_RMBTrap;
  83.  windowtags[7].ti_Data:=Integer(TRUE);
  84.  windowtags[8].ti_Tag:=WA_Activate;
  85.  windowtags[8].ti_Data:=Integer(TRUE);
  86.  windowtags[9].ti_Tag:=WA_CloseGadget;
  87.  windowtags[9].ti_Data:=Integer(TRUE);
  88.  windowtags[10].ti_Tag:=WA_DepthGadget;
  89.  windowtags[10].ti_Data:=Integer(TRUE);
  90.  windowtags[11].ti_Tag:=WA_DragBar;
  91.  windowtags[11].ti_Data:=Integer(TRUE);
  92.  windowtags[12].ti_Tag:=WA_SizeGadget;
  93.  windowtags[12].ti_Data:=Integer(TRUE);
  94.  windowtags[13].ti_Tag:=WA_SizeBBottom;
  95.  windowtags[13].ti_Data:=Integer(TRUE);
  96.  windowtags[14].ti_Tag:=WA_GimmeZeroZero;
  97.  windowtags[14].ti_Data:=Integer(TRUE);
  98.  windowtags[15].ti_Tag:=WA_ScreenTitle;
  99.  windowtags[15].ti_Data:=Integer(ScreenTitle);
  100.  windowtags[16].ti_Tag:=WA_IDCMP;
  101.  windowtags[16].ti_Data:=IDCMP_RAWKEY+IDCMP_CLOSEWINDOW;
  102.  windowtags[17].ti_Tag:=TAG_END;
  103.  
  104.  GFXBase:=OpenLibrary (gfxname,0);
  105.  IF GFXBase<>Nil Then
  106.  Begin
  107.   P96Base:=OpenLibrary (P96NAME,0);
  108.   If P96Base<>Nil Then
  109.   Begin
  110.    ptags[0].ti_Tag:=P96SA_Width;
  111.    ptags[0].ti_Data:=Width;
  112.    ptags[1].ti_Tag:=P96SA_Height;
  113.    ptags[1].ti_Data:=Height;
  114.    ptags[2].ti_Tag:=P96SA_Depth;
  115.    ptags[2].ti_Data:=Depth;
  116.    ptags[3].ti_Tag:=P96SA_AutoScroll;
  117.    ptags[3].ti_Data:=Integer(TRUE);
  118.    ptags[4].ti_Tag:=P96SA_Pens;
  119.    ptags[4].ti_Data:=Integer(Adr(Pens));
  120.    ptags[5].ti_Tag:=P96SA_Title;
  121.    ptags[5].ti_Data:=Integer(ScreenTitle);
  122.    ptags[6].ti_Tag:=TAG_DONE;
  123.  
  124.    sc:=p96OpenScreenTagList (Adr(ptags));
  125.    If sc=Nil Then
  126.     Writeln ("Unable to open screen.")
  127.    Else
  128.    Begin
  129.     Dimensions[0]:=0;
  130.     Dimensions[1]:=sc^.BarHeight+1;
  131.     Dimensions[2]:=sc^.Width;
  132.     Dimensions[3]:=sc^.Height-sc^.BarHeight-1;
  133.  
  134.     ptags[0].ti_Tag:=WA_CustomScreen;
  135.     ptags[0].ti_Data:=Integer (sc);
  136.     ptags[1].ti_Tag:=WA_Title;
  137.     ptags[1].ti_Data:=Integer(W1Title);
  138.     ptags[2].ti_Tag:=WA_Left;
  139.     ptags[2].ti_Data:=(sc^.Width DIV 2-200) DIV 2+sc^.Width DIV 2;
  140.     ptags[3].ti_Tag:=WA_Top;
  141.     ptags[3].ti_Data:=(sc^.Height-sc^.BarHeight-300) DIV 2;
  142.     ptags[4].ti_Tag:=WA_Zoom;
  143.     ptags[4].ti_Data:=Integer(Adr(Dimensions));
  144.     ptags[5].ti_Tag:=TAG_MORE;
  145.     ptags[5].ti_Data:=Integer(Adr(WindowTags));
  146.  
  147.     wdp:=OpenWindowTagList (NIL,Adr(ptags));
  148.  
  149.     If wdp<>Nil Then
  150.     Begin
  151.      ptags[0].ti_Tag:=WA_CustomScreen;
  152.      ptags[0].ti_Data:=Integer (sc);
  153.      ptags[1].ti_Tag:=WA_Title;
  154.      ptags[1].ti_Data:=Integer(W2Title);
  155.      ptags[2].ti_Tag:=WA_Left;
  156.      ptags[2].ti_Data:=(sc^.Width DIV 2-200) DIV 2;
  157.      ptags[3].ti_Tag:=WA_Top;
  158.      ptags[3].ti_Data:=(sc^.Height-sc^.BarHeight-300) DIV 2;
  159.      ptags[4].ti_Tag:=WA_Zoom;
  160.      ptags[4].ti_Data:=Integer(Adr(Dimensions));
  161.      ptags[5].ti_Tag:=TAG_MORE;
  162.      ptags[5].ti_Data:=Integer(Adr(WindowTags));
  163.  
  164.      wdf:=OpenWindowTagList (NIL,Adr(ptags));
  165.      If wdf<>Nil Then
  166.      Begin
  167.       rpf:=wdf^.RPort;
  168.       rpp:=wdp^.RPort;
  169.       terminate:=False;
  170.       signals:=((1 shl wdf^.UserPort^.mp_SigBit) or (1 shl wdp^.UserPort^.mp_SigBit));
  171.       format:=RGBFTYPE (p96GetBitMapAttr (sc^.SRastPort.BitMap, P96BMA_RGBFORMAT));
  172.  
  173.       SelfSeed;
  174.  
  175.       Repeat
  176.        x1:=RangeRandom (wdf^.Width);
  177.        y1:=RangeRandom (wdf^.Height);
  178.        x2:=RangeRandom (wdf^.Width);
  179.        y2:=RangeRandom (wdf^.Height);
  180.        If x2<x1 Then
  181.        Begin
  182.         x3:=x2;
  183.         x2:=x1;
  184.         x1:=x3;
  185.        End;
  186.        If y2<y1 Then
  187.        Begin
  188.         y3:=y2;
  189.         y2:=y1;
  190.         y1:=y3;
  191.        End;
  192.  
  193.        x3:=RangeRandom (wdp^.Width);
  194.        y3:=RangeRandom (wdp^.Height);
  195.  
  196.        If format=RGBFB_CLUT Then
  197.        Begin
  198.         SetAPen (rpf, RangeRandom (255));
  199.         RectFill (rpf,x1,y1,x2,y2);
  200.  
  201.         SetAPen (rpp, RangeRandom (255));
  202.         WritePixel (rpp,x3,y3);
  203.        End
  204.        Else
  205.        Begin
  206.         p96RectFill (rpf, x1, y1, x2, y2,(RangeRandom(255) shl 16)+(RangeRandom(255) shl 8)+(RangeRandom (255)));
  207.  
  208.  
  209.         p96WritePixel (rpp, x3, y3, ((RangeRandom(255)) shl 16)+((RangeRandom(255)) shl 8)+(RangeRandom(255)));
  210.        End;
  211.  
  212.        Repeat
  213.         imsg:=Address(GetMsg (wdf^.UserPort));
  214.         If imsg<>Nil Then
  215.         Begin
  216.          If ((imsg^.Class=IDCMP_CLOSEWINDOW) Or ((imsg^.Class=IDCMP_RAWKEY) And ((imsg^.Code=$40) or (imsg^.Code=$45)))) Then
  217.           terminate:=True;
  218.          ReplyMsg (Address(imsg));
  219.         End;
  220.        Until imsg=Nil;
  221.        Repeat
  222.         imsg:=Address(GetMsg (wdp^.UserPort));
  223.         If imsg<>Nil Then
  224.         Begin
  225.          If ((imsg^.Class=IDCMP_CLOSEWINDOW) Or ((imsg^.Class=IDCMP_RAWKEY) And ((imsg^.Code=$40) or (imsg^.Code=$45)))) Then
  226.           terminate:=True;
  227.          ReplyMsg (Address(imsg));
  228.         End;
  229.        Until imsg=Nil;
  230.  
  231.       Until terminate;
  232.  
  233.       Forbid;
  234.       Repeat
  235.        msg:=GetMsg (wdf^.UserPort);
  236.        If msg<>Nil Then
  237.         ReplyMsg (msg);
  238.       Until msg=Nil;
  239.       Repeat
  240.        msg:=GetMsg (wdp^.UserPort);
  241.        If msg<>Nil Then
  242.         ReplyMsg (msg);
  243.       Until msg=Nil;
  244.       Permit;
  245.  
  246.       CloseWindow (wdf);
  247.      End
  248.      Else
  249.       Writeln ("Unable to open window 2.");
  250.      CloseWindow (wdp);
  251.     End
  252.     Else
  253.      Writeln ("Unable to open window 1.");
  254.  
  255.     p96CloseScreen (sc);
  256.    End;
  257.  
  258.    CloseLibrary (GfxBase);
  259.    CloseLibrary (P96Base);
  260.   End
  261.   Else
  262.   Begin
  263.    CloseLibrary (GfxBase);
  264.    Writeln ("Unable to open Picasso96 library.");
  265.   End;
  266.  End
  267.  Else
  268.   Writeln ("Unable to open Gfx library.");
  269. END.
  270.  
  271.